home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d21 / apishare.arc / SHAREA.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-22  |  5KB  |  181 lines
  1. (****************************************************************
  2. *
  3. *  Name:          SHAREA
  4. *
  5. *  Function:      share memory/data with another process
  6. *
  7. *  Shows how to:  1. allocate and deallocate shared memory.
  8. *                 2. read from and write to shared memory.
  9. *                 3. mail to another process the address of shared data.
  10. *                 4. control access to shared data via mailbox semaphore.
  11. *
  12. ****************************************************************)
  13.  
  14. program ShareA;
  15.  
  16. uses DVAPI;
  17.  
  18. const
  19.  
  20.   (* minimum API version required *)
  21.   REQUIRED = $201;
  22.   PIFLEN = 416;
  23.   ONEBLOCK = 1;
  24.  
  25. var
  26.  
  27.   (* API version number *)
  28.   version : integer;
  29.  
  30.   (* TFDD text file *)
  31.   tfd : text;
  32.  
  33.   (* PIF-related variables *)
  34.   fp : file;
  35.   dvpbuf : array [0..415] of byte;
  36.  
  37.   (* application handle of other process *)
  38.   apphanb : ULONG;
  39.  
  40. type
  41.  
  42.   (* type declarations related to shared data *)
  43.   DATATYPE = string;
  44.   DATAPTR = ^DATATYPE;
  45.  
  46. const
  47.  
  48.   (* constant value to be assigned to shared memory *)
  49.   SHRCONST : DATATYPE = 'AAAAA     ';
  50.  
  51. var
  52.  
  53.   (* pointer to shared data *)
  54.   shrptr : DATAPTR;
  55.  
  56.   (* mailbox semaphore controlling access to shared memory *)
  57.   sema : ULONG;
  58.  
  59. const
  60.  
  61.   (* global name of mailbox *)
  62.   name : string = 'Shared Memory Semaphore';
  63.  
  64.  
  65. (********************************************************************
  66. (*  program_body
  67. (*
  68. (*  Set up named mailbox semaphore.  Start other process.  Allocate
  69. (*  & initialize shared memory.  Mail pointer to shared data.
  70. (*  Continuously read, display and modify contents of shared data.
  71. (********************************************************************)
  72.  
  73. procedure program_body;
  74. begin
  75.  
  76.   (* open TFDD *)
  77.   tfd_open (tfd,win_me);
  78.  
  79.   (* create & name mailbox semaphore *)
  80.   sema := mal_new;
  81.   mal_sname (sema,name);
  82.  
  83.   (* disallow closing of window *)
  84.   win_disallow (win_me,ALW_CLOSE);
  85.  
  86.   (* read other process' dvp file into buffer area *)
  87.   assign (fp,'c:\dv\SB-PIF.DVP');
  88.   reset (fp,PIFLEN);
  89.   blockread (fp,dvpbuf,ONEBLOCK);
  90.   close (fp);
  91.  
  92.   (* start other process & get its task handle *)
  93.   apphanb := app_start (@dvpbuf,PIFLEN);
  94.  
  95.   (* allocate shared memory & get its buffer pointer *)
  96.   (* Api_getmem normally allocates "system memory" from within the
  97.   (* "process memory" pool.  Such system memory is not shareable among other
  98.   (* processes.  Instead, if system memory were to be allocated from the
  99.   (* "shared memory" pool then system memory would be shareable among other
  100.   (* processes.  In other words, all processes that use shared memory have
  101.   (* access to each others' system memory.  Placing a single asterisk (*)
  102.   (* in the Shared Memory Pathname field of the PIF file will accomplish this.
  103.   (* See Chapter 16: Memory Management of the API Reference Manual. *)
  104.   shrptr := api_getmem (sizeof (SHRCONST));
  105.  
  106.   (* copy initial data into shared memory *)
  107.   shrptr^ := SHRCONST;
  108.  
  109.   (* mail to other process the pointer to shared data *)
  110.   mal_write (mal_of (apphanb),@shrptr,sizeof (shrptr));
  111.  
  112.   (* begin critical region *)
  113.   api_beginc;
  114.  
  115.   (* loop till handle of other process is no longer valid *)
  116.   while (api_isobj (apphanb)) do
  117.   begin
  118.  
  119.     (* lock semaphore *)
  120.     mal_lock (sema);
  121.  
  122.     (* read & display current contents & address of shared data *)
  123.     writeln (tfd,shrptr^,' at ',seg (shrptr^),':',ofs (shrptr^));
  124.  
  125.     (* modify contents of shared data *)
  126.     shrptr^ := SHRCONST;
  127.  
  128.     (* unlock semaphore *)
  129.     mal_unlock (sema);
  130.  
  131.     (* end critical region *)
  132.     api_endc;
  133.  
  134.     (* begin critical region *)
  135.     api_beginc;
  136.  
  137.   end;
  138.  
  139.   (* free allocated shared memory *)
  140.   api_putmem (shrptr);
  141.  
  142.   (* allow closing of window *)
  143.   win_allow (win_me,ALW_CLOSE);
  144.  
  145.   (* free allocated object *)
  146.   mal_free (sema);
  147.  
  148.   (* close TFDD *)
  149.   tfd_close (tfd);
  150.  
  151. end;
  152.  
  153.  
  154. (**********************************************************************
  155. *  main  -  check for DESQview present and enable required extensions.
  156. ***********************************************************************)
  157.  
  158. begin
  159.  
  160.   (* initialize Pascal interfaces and get API version number *)
  161.   version := api_init;
  162.  
  163.   (* if DESQview is not running or version is too low, display a message *)
  164.   if (version < REQUIRED) then
  165.     writeln ('This program requires DESQview version ',REQUIRED div 256,
  166.        '.',(REQUIRED mod 256) div 16,(REQUIRED mod 256) mod 16,' or later.')
  167.  
  168.   else
  169.   begin
  170.  
  171.     (* tell DESQview what extensions to enable and start application *)
  172.     api_level (REQUIRED);
  173.     program_body;
  174.  
  175.     (* disable Pascal interfaces and return from program *)
  176.     api_exit;
  177.  
  178.   end;
  179.  
  180. end.
  181.